# dvir, 2011-08-31
# this class is for cases when we need to create many ped files, by a given ped file.
# the ped file will be read only once to the memory !

# for now, don't work with 2 diesase locus (only 1 diesase locus)

package PedWrapper;

# details about the structure of a dat file can be found at : 
# http://bioinfo.cs.technion.ac.il/superlink/Pedigree_File.html

use strict;
use General;

use Class::Struct;


struct PersonData =>
[
	firstFieldsText => '$', # this will be the columns : 3-10 including (first col no' is 1 and not 0)
	allels => '@', # the allels of the person, each cell will be the two allels of the marker
				   # cell 0 will be empty, and the allels of marker no' 1 will be at cell no' 1.
				   # for example '1 2' will be the content of cell 1, meaning that the person has those allels for marker 1.
	father => '$',
	mother => '$',
	sex => '$',
	affectionStatus => '$',
	isTyped => '$',
];

# the ped file may contain more than 1 family, and the families may be mixed 
# for example :
# line1 can be a person from family x
# line2 can be a person from family y
# line3 can be another person from family x
sub new( $ ) {
	my $class = $_[0]; # the name of this class
	# the ped file seperator can be tab or space or both.
	my $pedFileName = $_[1]; # may include a path
	my $numOfMarkers = $_[2];
	
	my %self = (); # empty hash for the class
	
	$self{NUM_OF_MARKERS} = $numOfMarkers;
	$self{NUM_OF_TYPED} = 0;
	
	# reading the lines (each line is a diffrenet person)
	open PED_FILE, $pedFileName;
	while (my $currLine = <PED_FILE>) {
		my @currLineArr = split /\s+/, $currLine;
		my $familyNum = $currLineArr[0];
		my $personNum = $currLineArr[1];
		my $father = $currLineArr[2];
		my $mother = $currLineArr[3];
		my $sex		  = $currLineArr[7];
		my $affectionStatus = $currLineArr[9];
		my $firstFieldsText = join ' ', @currLineArr[2..9];
		
		my $personData = PersonData->new();		
		$personData->firstFieldsText($firstFieldsText);
		$personData->father ($father);
		$personData->mother ($mother);
		$personData->sex ($sex);
		$personData->affectionStatus ($affectionStatus);
		my $currCell = 10;
		my $isTyped = "false";
		for (my $currMarker=1;$currMarker<=$numOfMarkers;++$currMarker) {
			${$personData->allels}[$currMarker] = "$currLineArr[$currCell] $currLineArr[$currCell+1]";
			# moving to the next marker allels
			$currCell+=2;
			if (not ((${$personData->allels}[$currMarker]) eq "0 0")){
				$isTyped = "true";
			}
		}
		$personData->isTyped ($isTyped);		
		
		# setting the current person data
		$self{FAMILIES}{$familyNum}{$personNum} = $personData;
		if (not defined($self{ORDERED_PEOPLE}{$familyNum})){
			$self{ORDERED_PEOPLE}{$familyNum} = [];
		}
		push(@{$self{ORDERED_PEOPLE}{$familyNum}} , $personNum);
	}
	close PED_FILE;
	
	return bless \%self, $class;
}

# possible values of the paramter $whatToWrite in writeSubPedFileByListOfMarker
our $WRITE_PERSON_DATA_AND_ALLELS = 'a';
our $WRITE_ONLY_PERSON_DATA = 'b';
our $WRITE_ONLY_ALLELS = 'c';
# $WRITE_PERSON_DATA_AND_2_DUMMY_0_ALLELS is used for the segregation program
our $WRITE_PERSON_DATA_AND_2_DUMMY_0_ALLELS = 'd';

# writes to the given file handle, a ped file with only of the given list of markers & list of families
sub writeSubPedFileByListOfMarker( \* \@ \@ $ $ ) {
	my $class = $_[0]; # the name of this class
	# reference for file handle to which the dat file will be written (concat at the end of the file)
	my $destFileHandleRef = $_[1];
	# assuming that the list of markers is a sorted list
	# this paramter is treated only when callling at $WRITE_PERSON_DATA_AND_ALLELS & $WRITE_ONLY_ALLELS
	# at other cases it can be an arbitrary array, for example an empty array.
	my $listOfMarkersArrRef = $_[2];
	my $listOfFamiliesArrRef = $_[3];
	# not a must param, can be ommited
	# because some executeables of superlink requires the family num to be 1, than
	# if this indication is set, than we will change the family num to be 1.
	# this is relevant only when the listOfFamiliesArrRef contains only one family.
	my $shouldSetFamilyNumToBe1 = $_[4];
	# $whatToWrite is not obligatory and can be one of : $WRITE_PERSON_DATA_AND_ALLELS, $WRITE_ONLY_PERSON_DATA, $WRITE_ONLY_ALLELS, $WRITE_PERSON_DATA_AND_2_DUMMY_0_ALLELS
	my $whatToWrite = $_[5];
	
	if (not defined $shouldSetFamilyNumToBe1) {
		$shouldSetFamilyNumToBe1 = 0;
	}
	if (not defined $whatToWrite) {
		$whatToWrite = $WRITE_PERSON_DATA_AND_ALLELS;
	}	
	
	# checking that the markers are sorted and all the markers exists
	my $numOfMarkers = $class->{NUM_OF_MARKERS};
	my $prevMarkerNum = 0; # for start
	for my $currMarkerNum (@$listOfMarkersArrRef) {
		# checks
		if ($currMarkerNum > $numOfMarkers || $currMarkerNum <= 0) {
			&General::reportOnErrorReleaseSemaphoresAndDie("PedWrapper.pm", "", "wrong marker num: $currMarkerNum, numOfMarkers: $numOfMarkers");
		}
		elsif ($currMarkerNum <= $prevMarkerNum) {
			&General::reportOnErrorReleaseSemaphoresAndDie("PedWrapper.pm", "", "The markers list isn't sorted!\ncurrMarkerNum: $currMarkerNum, prevMarkerNum: $prevMarkerNum");
		}
		$prevMarkerNum = $currMarkerNum;
	}
	
	# printing
	# passing over the desired families
	for my $currFamiliy (@$listOfFamiliesArrRef) {
		my $familyNum = $currFamiliy; 
		if ($shouldSetFamilyNumToBe1) {
			$familyNum = 1;
		}
		
		# sorting cause some of the executeables required that the person list will be sorted
		my @familyMembers = keys %{$class->{FAMILIES}{$currFamiliy}};
		@familyMembers = sort {$a <=> $b} @familyMembers;
		
		# passing over the familiy members
		for my $personNum (@familyMembers) {
			my $personData = $class->{FAMILIES}{$currFamiliy}{$personNum};

			if ($whatToWrite eq $WRITE_PERSON_DATA_AND_ALLELS || 
			    $whatToWrite eq $WRITE_ONLY_PERSON_DATA || 
				$whatToWrite eq $WRITE_PERSON_DATA_AND_2_DUMMY_0_ALLELS) {				
				print $destFileHandleRef 
					"$familyNum $personNum ".$personData->firstFieldsText();
			}
			
			# printing the markers allels
			if ($whatToWrite eq $WRITE_PERSON_DATA_AND_ALLELS || 
			    $whatToWrite eq $WRITE_ONLY_ALLELS) {
				for my $currMarkerNum (@$listOfMarkersArrRef) {
					print $destFileHandleRef 
						' '.${$personData->allels}[$currMarkerNum];
				}
			}
			
			# printing a single marker allels
			if ($whatToWrite eq $WRITE_PERSON_DATA_AND_2_DUMMY_0_ALLELS) {				
				print $destFileHandleRef 
					' 0 0';
			}
			
			print $destFileHandleRef "\n";
		}
	}	
}

# returning the families numbers
sub getFamiliesNumbers() {
	my $class = $_[0]; # the name of this class
	
	return keys %{$class->{FAMILIES}};
}
#return all members in a family
#Input: family number
sub getFamilyMembers {
	my ($self, $familyNumber) = @_;

	return @{$self->{ORDERED_PEOPLE}{$familyNumber}};

}
#return the parent of a person
#Input: "0" for father, "1" for mother
sub getParent{
	my ($self, , $familyNumber, $personNumber, $parent) = @_;
	my $personData =$self->{FAMILIES}{$familyNumber}{$personNumber};
	if ($parent eq "0"){
		return $personData->father();
	}
	else{
		return $personData->mother();
	}
}



1;